perm filename MARK2.SAI[X,ALS] blob
sn#082468 filedate 1974-01-21 generic text, type T, neo UTF8
00010 BEGIN "MARKX"
00020 DEFINE ⊂="COMMENT"; ⊂ NOV.26,1973;
00030 ⊂ This program is a very simple pitch marking routine to be used to
00040 suppliment Neil's routine in certain cases;
00050 DEFINE ⊃="⊂";
00060 DEFINE CR="'15",LF="'12",CRLF="CR&LF",TB="'11";
00070 REQUIRE "DPYSUB.HDR[1,PDQ]" SOURCE_FILE;
00080 LABEL STARTP,STOPP,TOFORM;
00090 DEFINE \=" "; ⊂ DEFINE \="SAFE"; ⊂ Alternarte definitions;
00100 INTEGER SUM,SUMM,SUMP,MAX,MIN,
00110 SUMREF,SUMSAV,SUMMIN,SUMMAX,SUMOLD;
00120 INTEGER MAXOLD,MINOLD,MARGIN,PER,PERMIN,PERMAX;
00130 INTEGER QOLD,QSAVE,QREF,QOLD2;
00140 INTEGER ZEROC,ZEROF,DX;
00150 EXTERNAL INTEGER INFLAG,NX;
00160 \ INTERNAL INTEGER ARRAY D[0:767];
00170 REAL X,SX; \ REAL ARRAY WINDOW[0:512];
00180 INTERNAL REAL R0;
00190 INTEGER LPCOPT;
00200 \ INTEGER ARRAY DPYBUF[0:1535];
00210 \ INTERNAL INTEGER ARRAY FVAL,NVAL[0:8];
00220 \ EXTERNAL INTEGER ARRAY NEW[0:512];
00230 INTEGER FX;
00240 INTEGER I,J,K,L,P,PP,Q,QQ,R,DK,DDK,DDDK,DVAL,DDVAL,DDDVAL,ALPHA,
00250 POINTF,POINTX,STATE,DELTA,DELTN,VAL,CHAN1,EOF,POINTT,POINTV;
00260 INTERNAL INTEGER M,N,PERIOD;
00270 INTEGER PT0,PT1,PT2,X0,X1,Y0,Y1,X2,Y2,
00280 PTCNT,PICK,JP,JPP,JPX,OPT,OPT1,SHUFCT;
00290 INTEGER II,JJ,KK,NN,SEGC,BRK,EOFA,EOFT,EOFTF,READ3,LFX,PITX,PITY,
00300 SEGTOT,SEGIN,KKT,NNT,ITT,JTT,KTT;
00310 BOOLEAN ER;
00320 INTEGER CHAN2,CHAN3,CHAN4,CHAN6,CHANX;
00330 INTERNAL INTEGER CHAN5;
00340 \ INTEGER ARRAY BUF,BUFT,BUFTT[0:511];
00350 STRING FILEN,FILEF,READ,READ1,READT,
00360 READTT,FILEO,READ2,FILEQ,TFILE,FILLST,FILEP;
00370
00380 INTEGER ARRAY QRES,SUMRES,SPAN[0:7];
00390 INTEGER QX,XXP,XXM;
00400
00410
00420 PROCEDURE OUTALL(STRING S);
00430 BEGIN
00440 STRING SS; INTEGER J;
00450 SETBREAK(18,0,NULL,"OSN");
00460 SS←SCAN(S,18,J);
00470 OUTSTR(SS);
00480 END;
00490
00500 PROCEDURE DATAIN;
00510 BEGIN
00520 INTEGER J;
00530 FOR J←0 STEP 1 UNTIL 511 DO BUF[J]←0;
00540 ⊂ IF EOF=0 THEN OUTSTR("BUF") ELSE OUTSTR(" EOF ");
00550 IF EOF=0 THEN ARRYIN(CHAN1,BUF[0],512);
00560 ⊂ IF EOF=0 THEN OUTSTR(" New BUF ") ELSE OUTSTR(" EOF ");
00570 POINTX←POINT(12,BUF[0],-1);
00580 SEGC←II←II+12; JJ←II+11;
00590 END;
00600
00610
00620 PROCEDURE DTTTIN;
00630 BEGIN
00640 INTEGER J;
00650 IF EOFT=0 THEN ARRYIN(CHAN3,BUFTT[0],512)
00660 ELSE OUTSTR
00670 ("No more .P data with JJ= "&CVS(JJ)&"SEGC= "&CVS(SEGC)&CRLF);
00680 FOR J←0 STEP 1 UNTIL 511 DO IF BUFTT[J]=0 THEN BUFTT[J]←'377777777777;
00690 ITT←BUFTT[0] LSH -15; KTT←0; JTT←BUFTT[511] LSH -15;
00700 ⊂ FOR J←0 STEP 1 UNTIL 10 DO OUTSTR(CVOS(BUFTT[J])&TB);
00710 END;
00720
00730
00740 PROCEDURE DATOUT;
00750 BEGIN "DATOUT"
00760 INTEGER I,J;
00770
00780 ARRYOUT(CHAN5,BUFT[0],512);
00790 FOR I←0 STEP 1 UNTIL 511 DO BUFT[I]←0;
00800 END "DATOUT";
00810
00820
00830 PROCEDURE MARK;
00840 BEGIN "MARK"
00850 INTEGER I,JJ,K,L,JJP,LP,PT2;
00860
00870 RIVECT(0,-130); SETFORMAT(3,0);
00880 FOR I←0 STEP 20 UNTIL 340 DO BEGIN
00890 DPYSST(CVS(I)); RIVECT(15,0); END;
00900 RIVECT(-555,30); RIVECT(-500,0);
00910
00920 FOR I←0 STEP 100 UNTIL 300 DO BEGIN "HUNDRED"
00930 RIVECT(0,30); RVECT(0,-30);
00940 FOR JJ←0 STEP 50 UNTIL 50 DO BEGIN "FIFTY"
00950 FOR K←1 STEP 1 UNTIL 5 DO BEGIN "TEN"
00960 RIVECT(15,0); RVECT(0,5); RIVECT(0,-5);
00970 RIVECT(15,0); RVECT(0,10);RIVECT(0,-10);
00980 END "TEN";
00990 RVECT(0,20); RIVECT(0,-20);
01000 IF I≥300 THEN DONE "HUNDRED";
01010 END "FIFTY";
01020 END "HUNDRED";
01030 RIVECT(-550,100); RIVECT(-500,0);
01040
01050 K←D[0]%8; RIVECT(0,K);
01060 FOR I←1 STEP 1 UNTIL 350 DO BEGIN
01070 JJP←D[I]%8;
01080 LP←JJP-K; RVECT(3,LP); K←JJP; END;
01090 RIVECT(-550,-K); RIVECT(-500,0);
01100
01110 RIVECT(500,0);
01120 FOR JJ←1 STEP 1 UNTIL 2 DO IF FVAL[JJ]≤375 THEN BEGIN
01130 L←3*FVAL[JJ]-500;
01140 RIVECT(L,120); RVECT(0,-70); RIVECT(0,-25); RVECT(0,-25);
01150 RIVECT(-25,0); RVECT(50,0);
01160 RIVECT(-25,0); RIVECT(-L,0); END;
01170
01180 FOR JJ←1 STEP 1 UNTIL 3 DO IF NVAL[JJ]≤375 THEN BEGIN
01190 L←3*NVAL[JJ]-500;
01200 RIVECT(L,0);RIVECT(-25,0); RVECT(50,0);
01210 RIVECT(-25,0); RVECT(0,-120); RIVECT(-L,120); END;
01220
01230 RIVECT(-500,0);
01240 DPYOUT(0); PTOCHW(0,'10120); SETFORMAT(1,0);
01250
01260
01270 END "MARK";
01280
01290 INTERNAL PROCEDURE CALCOMP(STRING FILE;INTEGER ARRAY BUFR);
01300 ⊃ Outputs display buffer BUFR to disk file FILE in a format
01310 readable by the Nealy Calcomp plotter program PLTVEC, and by
01320 the Quam Video Synthesizer program MIRTOP;
01330 IF FILE THEN
01340 BEGIN INTEGER DSIZ,CCCHN;
01350 OPEN(CCCHN←GETCHAN,"DSK",'14,0,1,0,0,0);
01360 ENTER(CCCHN,FILEN&".GRF",0);
01370 DPYPARS;DSIZ←BUFR[1]+4;
01380 ARRYOUT(CCCHN,BUFR[0],2);WORDOUT(CCCHN,0);
01390 ARRYOUT(CCCHN,BUFR[2],DSIZ-2);
01400 RELEASE(CCCHN);
01410 END "CALCOMP";
01420
01430
01440 PROCEDURE PEEK;
01450 BEGIN
01460
01470 OUTSTR(CRLF&"Q'S "&CVS(QREF)&" "&CVS(QSAVE)&" "&CVS(QOLD)&TB&" P="&CVS(P)&
01480 TB&"SUM'S "&CVS(SUMREF)&" "&CVS(SUMSAV)&" "&CVS(SUMOLD)&
01490 TB&"PERIOD="&CVS(PERIOD)&" "&CVS(PER)&CRLF);
01500 END;
01510
01520 PROCEDURE SPOR;
01530 BEGIN
01540 ⊂ OUTSTR(CVS(STATE)&" ");
01550 END;
01560
01570 PROCEDURE PITCH;
01580 BEGIN "PITCH"
01590
01600 CASE STATE OF BEGIN
01610
01620 ⊂ State 0 from 2 on - ;
01630 IF VAL>0 THEN BEGIN
01640 STATE←2; QOLD←QQ; SUMP←MAX←VAL;
01650 SPOR;
01660 END;
01670
01680 ⊂ STATE 1 from 5 on + ;
01690 IF VAL<0 THEN BEGIN
01700 IF XXP<2 THEN BEGIN
01710 STATE←5; SUM←SUM+SUMP-VAL;
01720 SPOR;
01730 IF MAXOLD>MAX THEN MAX←MAXOLD;
01740 END;
01750 END ELSE BEGIN
01760 SUMP←SUMP+VAL;
01770 IF VAL<ALPHA THEN BEGIN SUMP←VAL; QOLD←QQ-1; END;
01780 IF VAL>MAX THEN MAX←VAL;
01790 IF SUMP>DELTA THEN BEGIN
01800 STATE←2; SUM←0;
01810 SPOR;
01820 ⊂ PEEK;
01830 ⊂ Decision;
01840 P←0;
01850 IF (SUMSAV=SUMREF)∧(PER>PERIOD*3%2)
01855 THEN P←1 ELSE
01860 IF (SUMREF=SUMSAV)∧(PER>PERIOD*3%4)∧(QOLD-QSAVE>PERIOD*3%4)
01870 THEN P←2 ELSE
01890 IF (SUMOLD<SUMSAV) THEN SUMSAV←SUMOLD ELSE
01900 IF (SUMOLD>SUMSAV)∧(PER>PERIOD*3%4)∧(SUMOLD>SUMREF%2)
01910 THEN P←3 ELSE
01930 IF (SUMOLD>SUMSAV)∧(PER>PERIOD*9%10)∧(SUMOLD>SUMMIN)
01940 THEN P←4 ELSE
01945 IF (SUMREF≤SUMMIN)∧(SUMOLD>SUMREF)
01947 THEN P←5 ELSE
01950 IF (SUMOLD>SUMREF*5%4)∧(PER>PERIOD*5%8)
01980 THEN P←6; ⊂ To get in step;
02010 IF (PER>PERIOD*3%2)∧(P=0) THEN BEGIN
02020 K←0;
02030 FOR I←0 STEP 1 UNTIL 7 DO
02040 IF SUMRES[I]>K THEN BEGIN K←SUMRES[I]; QX←I; END;
02050 IF K>0 THEN BEGIN
02060 QSAVE←QRES[QX]; SUMOLD←SUMRES[QX]; P←7;
02070 END;
02080 END;
02085
02087 IF ((QRES[QX]-QREF)>(PERIOD*3%4))∧(P=0)∧(QX<7) THEN BEGIN
02088 OUTSTR(CRLF&"QX="&CVS(QX)&TB&CVS(QRES[QX])&TB&CVS(SUMRES[QX])&TB&CVS(SPAN[QX]));
02089 QX←QX+1; END;
02090 IF P>0 THEN BEGIN
02100 ⊂ Record mark;
02110 WHILE (BUFT[PITX-1] LSH -15)≥QSAVE DO BEGIN
02120 PITX←PITX-1; QREF←QREF-PERIOD; END;
02130 BUFT[PITX]←(QSAVE LSH 15)+(SUMOLD LAND '77770)+(P LAND '7);
02140 PEEK;
02150 SUMREF←SUMOLD; PER←QSAVE-QREF; QREF←QSAVE;
02160 PITX←PITX+1;
02170 IF (PER>PERMIN)∧(PER<PERMAX) THEN PERIOD←(2*PERIOD+PER)%3;
02200 FOR I←0 STEP 1 UNTIL 7 DO SUMRES[I]←SPAN[I]←0;
02205 QX←0;
02210 JPP←0;
02230 END;
02240 END;
02250 END;
02260
02270 ⊂ STATE 2 from 0 on + from 1 on alpha with decision;
02280 IF VAL<0 THEN BEGIN STATE←0; SPOR; END ELSE BEGIN
02290 SUMP←SUMP+VAL; IF VAL>MAX THEN MAX←VAL;
02300 IF VAL<MARGIN THEN QOLD←QQ-1 ELSE
02310 IF SUMP>DELTA THEN BEGIN
02320 XXM←0;
02330 STATE←3; QRES[QX]←QSAVE←QOLD; SUMSAV←SUMOLD;
02340 SPOR;
02350 END;
02360
02370 END;
02380
02390 ⊂ STATE 3 from 4 on + from 2 on delta;
02400 IF VAL<0 THEN BEGIN
02410 XXM←XXM+1;
02420 STATE←4; SUMM←MIN←VAL;
02430 SPOR;
02440 END ELSE BEGIN
02450 SUMP←SUMP+VAL; IF VAL>MAX THEN MAX←VAL;
02460 END;
02470
02480 ⊂ STATE 4 from 3 on - ;
02490 IF VAL>0 THEN BEGIN
02500 IF XXM<2 THEN BEGIN
02510 STATE←3; SUMP←SUMP+VAL-SUMM;
02520 SPOR;
02530 END;
02540 END ELSE BEGIN
02550 SUMM←SUMM+VAL; IF VAL<MIN THEN MIN←VAL;
02560 IF SUMM<DELTN THEN BEGIN
02570 STATE←5; SUMRES[QX]←SUM←SUMP-SUMM; SUMP←SUMM←0;
02580 SPOR;
02590 END;
02600 END;
02610
02620 ⊂ STATE 5 from 2 on - from 4 on DELTN;
02630 IF VAL>0 THEN BEGIN
02640 STATE←1;
02650 SPOR;
02660 ⊂ Prepare for decision;
02670 MAXOLD←MAX; MINOLD←MIN; SUMRES[QX]←SUMOLD←SUM;
02675 SPAN[QX]←MAX-MIN;
02680 SUMP←MAX←VAL; ⊂ QSAVE←QOLD; QOLD←QQ;
02690 END ELSE BEGIN
02700 SUM←SUM-VAL; IF VAL<MIN THEN MIN←VAL;
02710 END;
02720 END;
02730
02740 QQ←QQ+1;
02750
02760
02770 IF ((QQ-QREF)≥PERIOD*2) THEN BEGIN
02780 BUFT[PITX]←(QREF+PERIOD) LSH 15;
02790 PITX←PITX+1; QREF←QREF+PERIOD; QSAVE←QQ; PER←PERIOD;
02800
02810 STATE←0;
02820 SPOR;
02830 END;
02840 END "PITCH";
00010 FILEN←"HI20.001[CMP,VIN]";
00020 FILEO←"SEG1.ALS[SYN,ALS]";
00030 PERIOD←180; PERMAX←220; PERMIN←100; MARGIN←50; DELTA←100; DELTN←-50; QQ←0;
00040 SUMMIN←200; ALPHA←40;
00050
00060 STDBRK(1);
00070 SETBREAK(14,"∃",NULL,"INS");
00080 SETBREAK(15,'11&'12&'14&'15&'40,NULL,"INS");
00090 SETBREAK(16,'56,NULL,"INA");
00100 SETBREAK(17,'12,'15,"INS");
00110
00120 CHAN1←1; CHAN2←2; CHAN3←3; CHAN4←4; CHAN5←5; CHAN6←6;
00130 OUTSTR("This program generates a file of pitch markers similar to "&
00140 "the .P files"&CRLF&" but with extension of .ALS."&CRLF);
00150 OUTSTR("At present this program takes acoustic data from [CMP,VIN],"&
00160 CRLF&TB&"and pulse informstion from .P[PIT,NJM] files"&CRLF&TB&CRLF&LF);
00170
00180
00190 STARTP:
00200
00210 OUTSTR(CRLF&"Type number of file to start (CR only for 1) ");
00220 IF (READ←INCHWL)="" THEN PP←1 ELSE PP←CVD(READ);
00230 OUTSTR("Start display with sample # (CR for first phone) ");
00240 IF (READ←INCHWL)="" THEN BEGIN NVAL[0]←0; JPP←1; END ELSE BEGIN
00245 JPP←0; NVAL[0]←CVD(READ); END;
00250
00260 ⊂ Begin FILEREAD;
00270 FOR PP←PP STEP 1 UNTIL 26 DO BEGIN "FILEREAD"
00280 CLOSE(CHAN1); OPEN(CHAN1,"DSK",'10,2,0,0,0,EOF);
00290 SETFORMAT(-3,0); FILEQ←CVS(PP);
00300 FILEN←FILEN[1 TO 5]&FILEQ&"[CMP,VIN]";
00310 LOOKUP(CHAN1,FILEN,ER); TFILE←FILEN;
00320 WHILE ER DO BEGIN
00330 IF PP>1 THEN BEGIN OUTSTR("Out of data, will terminate."&CRLF);
00340 GOTO STOPP; END;
00350 OUTSTR(CRLF&"Can not find file "&TFILE&" File= ");
00360 LOOKUP(CHAN1,TFILE←INCHWL,ER); END;
00370 J←K←L←STATE←VAL←0; R←-1;
00380 SETFORMAT(1,0); FILEQ←CVS(PP); JP←10000; R←-1; CLRBUF;
00390 II←-11; JJ←-1;
00400
00410 DATAIN; SUMREF←SUMOLD←SUMSAV←SUMMIN;
00420 PITX←0; BUFT[PITX]←1; PITX←1;
00430 FOR J←0 STEP 1 UNTIL 767 DO BEGIN
00440 VAL←ILDB(POINTX); IF VAL>2047 THEN VAL←VAL-4096;
00450 D[J]←VAL; PITCH; END;
00460 SEGIN←6; FVAL[1]←FVAL[2]←0;
00470
00480
00490 FILEP←FILEO[1 TO 3]&FILEQ&".ALS[SYN,ALS]";
00500 CLOSE(CHAN5); OPEN(CHAN5,"DSK",'14,0,2,0,0,0);
00510 ENTER(CHAN5,FILEP,0);
00520 OUTSTR("File "&FILEP&" has been opened"&CRLF);
00530
00540
00550 READ2←FILEP;
00560 READTT←SCAN(READ2,16,J)&"P[PIT,NJM]";
00570 ⊂ OUTSTR(READTT&CRLF);
00580 CLOSE(CHAN3); OPEN(CHAN3,"DSK",'10,10,0,0,0,EOFT);
00590 LOOKUP(CHAN3,READTT,ER); TFILE←READTT;
00600 IF ER THEN BEGIN
00610 OUTSTR("File "&READTT&" not found (S to start, space bar to ignore) ");
00620 IF (READ1←INCHRW)="S" THEN GOTO STARTP ELSE BEGIN
00630 BUFTT[0]←'77777; BUFTT[1]←'377777700000;ITT←0; JTT←'3777777;
00640 CLRBUF; END; END;
00650
00660 FOR I←1 STEP 1 UNTIL 8 DO FVAL[I]←0;
00670 DTTTIN;
00680 FVAL[4]←BUFTT[0]; FVAL[1]←(FVAL[4] LSH -15)-(SEGIN-6)*128;
00690 FVAL[5]←BUFTT[1]; FVAL[2]←(FVAL[5] LSH -15)-(SEGIN-6)*128;
00700 FVAL[6]←BUFTT[2]; FVAL[3]←(FVAL[6] LSH -15)-(SEGIN-6)*128;KTT←2;
00710 NVAL[5]←BUFT[0]; NVAL[2]←(NVAL[5] LSH -15)-(SEGIN-6)*128;
00720 NVAL[6]←BUFT[1]; NVAL[3]←(NVAL[6] LSH -15)-(SEGIN-6)*128; PITY←1;
00730
00740
00750
00760
00770 ⊂ Begin "GET";
00780
00790 WHILE TRUE DO BEGIN "GET"
00800
00810
00820 ⊂ OUTSTR("JTT="&CVS(JTT)&TB&"J="&CVS(J)&CRLF);
00830 IF JJ<SEGIN THEN IF EOF≠0 THEN DONE "GET" ELSE DATAIN;
00840
00850 ⊂ OUTSTR("JJ="&CVS(JTT)&TB&"J="&CVS(J)&"before DTTTIN");
00860 IF JTT<(SEGIN-1)*128 THEN DTTTIN;
00870 ⊂ OUTSTR(" and after JTT="&CVS(JTT)&CRLF);
00880
00890 ⊂ FVAL and NVAL assignments (NVAL are newly computed values)
00900 [1] DELTA FOR FIRST MARKER
00910 [2] DELTA FOR SECOND MARKER
00920 [3] DELTA FOR THIRD MARKER
00930 [4] PULSE DATE FOR FIRST MARKER
00940 [5] PULSE DATA FOR SECOND MARKER
00950 [6] PULSE DATA FOR THIRD MARKER;
00960
00970
00980 NVAL[1]←NVAL[2]; NVAL[4]←NVAL[5];
00990
01000 WHILE NVAL[1]>127 DO BEGIN
01010 IF SEGIN≥JJ THEN IF EOF≠0 THEN DONE "GET" ELSE DATAIN;
01020 FOR Q←0 STEP 1 UNTIL 639 DO D[Q]←D[Q+128];
01030 FOR Q←640 STEP 1 UNTIL 767 DO BEGIN
01040 VAL←ILDB(POINTX); IF VAL>2047 THEN VAL←VAL-4096;
01050 D[Q]←VAL; PITCH; END; SEGIN←SEGIN+1; ⊂ OUTSTR("RELOAD"&CRLF);
01060 FVAL[1]←FVAL[1]-128; FVAL[2]←FVAL[2]-128; FVAL[3]←FVAL[3]-128;
01070 NVAL[1]←NVAL[1]-128; NVAL[3]←NVAL[3]-128; END;
01080
01090 WHILE FVAL[1]<0 DO BEGIN FVAL[1]←FVAL[2]; FVAL[2]←FVAL[3];
01100 FVAL[4]←FVAL[5]; FVAL[5]←FVAL[6];
01110 KTT←KTT+1; IF KTT≥512 THEN DTTTIN;
01120 FVAL[6]←BUFTT[KTT];
01130 FVAL[3]←(FVAL[6] LSH -15)-(SEGIN-6)*128;END;
01140
01150 NVAL[2]←NVAL[3]; NVAL[5]←NVAL[6];
01160 PITY←PITY+1;
01170 NVAL[6]←BUFT[PITY];
01180 NVAL[3]←(NVAL[6] LSH -15)-(SEGIN-6)*128;
01190
01200 ⊂ OUTSTR(CVS(FVAL[1])&TB&CVS(FVAL[2])&TB&CVS(FVAL[3])&
01210 TB&CVS(FVAL[4] LSH -15)&TB&
01220 CVS(FVAL[5] LSH -15)&TB&CVS(FVAL[6] LSH -15)&CRLF);
01230 ⊂ OUTSTR(CVS(NVAL[1])&TB&CVS(NVAL[2])&TB&CVS(NVAL[3])&
01240 TB&CVS(NVAL[4] LSH -15)&TB&
01250 CVS(NVAL[5] LSH -15)&TB&CVS(NVAL[6] LSH -15)&CRLF);
01260
01270 ⊂ OUTSTR(CRLF&CVS(SEGIN)&TB&CVS(FVAL[1])&TB&CVS(FVAL[2])&TB&CVS(FVAL[3])&TB&
01280 CVS(FVAL[4] LSH -15)&
01290 " "&CVS(FVAL[5] LSH -15)&" "&CVS(FVAL[6] LSH -15)&TB&TB);
01300
01310
01320 R←R+1; OUTSTR(CVS(NVAL[4] LSH -15)&TB); IF (R MOD 10)=9 THEN OUTSTR(CRLF);
01330
01340
00010 JP←JP-1; READ1←INCHRS;
00020 IF (READ1="F")∨(READ1="f") THEN BEGIN CLRBUF; READ1←"";
00030 JP←-10; OUTSTR(CRLF&LF&"Will stop at the end of this file"&CRLF&LF); END;
00040 IF (READ1="E")∨(READ1="e") then goto stopp;
00050
00060 IF (READ1=" ")∨((JPP=0)∧((NVAL[5] LSH -15)>NVAL[0])) THEN BEGIN "SHOW"
00070 ⊂ IF (READ1=" ")∨((ABS(FVAL[1]-NVAL[1])>5)∨(ABS(FVAL[2]-NVAL[2])>5)) THEN
00080 BEGIN "SHOW";
00090 TYPLOC(512,170); DPYSET(DPYBUF);
00100 JP←1;
00110 OUTSTR(CRLF&"File "&FILEN&TB);
00120 OUTSTR("from "&CVS(NVAL[4] LSH -15)
00130 &" to "&CVS(NVAL[5] LSH -15)&TB&CVOS(NVAL[4] LAND '77777)&","&
00140 CVOS(NVAL[5] LAND '77777)&TB&CVS(SUMREF)&CRLF);
00150 AIVECT(-599,0);MARK;
00160 DPYOUT(0);PTOCHW(0,'10120);
00170 ⊂ OUTSTR("Type P for XGP copy file or type next command.");
00180 ⊂ OUTSTR("Space to run, LF for next, # for sample #, +# to add periods."&CRLF);
00190
00200 READ1←INCHRW;
00210 WHILE (READ1="W")∨(READ1="w") DO BEGIN DPYOUT(0) ;
00220 PTOCHW(0,'10120);READ1←INCHRW; END;
00230 IF (READ1="P")∨(READ1="p") THEN BEGIN CALCOMP("PLOTX",DPYBUF);
00240 OUTSTR("EX DPYXGP[X,ALS] plots PLOTX.GRF on the XGP. Next command please."&CRLF);
00250 READ1←INCHRW; END;
00260 K←CVASC(READ1); OPT1←0;
00270
00280 IF K=CVASC("+") THEN BEGIN
00290 JP←CVD(INCHWL); NVAL[0]←10000; END;
00300 IF K≥CVASC("0") THEN IF K≤CVASC("9") THEN BEGIN
00310 NVAL[0]←CVD(READ1&INCHWL); JP←10000; END;
00330 IF(READ1="F")∨(READ1="f") THEN JP←-1;
00340 IF (READ1="E")∨(READ1="e") THEN GOTO STOPP;
00350
00360 IF (READ1='15)∨(READ1='12) THEN BEGIN JP←1; NVAL[0]←0; CLRBUF; END;
00370
00380 TOFORM:
00390 IF (READ1="S")∨(READ1="s") THEN JP←JP+1;
00400 IF (READ1="E")∨(READ1="e") THEN GOTO STOPP;
00410 PTOCHW(0,'10103); CLRBUF; TYPLOC(512,-170); PTOCHW(0,'10120);
00420 END "SHOW";
00430
00440
00450 END "GET";
00460 CLOSE(CHAN1); CLOSE(CHAN3);
00470 DATOUT; CLOSE(CHAN5);
00480 IF JP<0 THEN DONE;
00490 END "FILEREAD";
00500
00510 OUTSTR("Data are exhausted"&CRLF&LF);
00520 STOPP: PTOCHW(0,'10103); PTOCHW(0,'10120);
00530 CLOSE(CHAN1);CLOSE(CHAN2);CLOSE(CHAN3);
00540 CLOSE(CHAN4);CLOSE(CHAN5);CLOSE(CHAN6);
00550
00560 END "MARKX";
00570